
#|____________________________________________________
 |                                                    |
 |         TWIDDLE - The Dynamic ViSta Logo           |
 |                                                    |
 |      Copyright (c) 2001 by Forrest W. Young        |
 |               All rights reserved                  |
 |____________________________________________________|
 |#

(defun twiddle (&key (text nil) (hide-logo nil) (wire-frame nil) (container nil)
                     (show-time nil used-show-time?) (static nil) (disolve nil)
                     (x 50) (y 0) (justify "left") (margin '(0 0 0 0)) (show t)
                     (delay 0) (pause nil) (speed-multipier 1) (speed 1) (repeat nil)
                     (title nil) 
                     (full-screen nil set)  (location nil) (size '(440 220) size?)
                     (top-most nil) (draw-color 'yellow) (back-color 'black) 
                     (content-proportion 1)
                     (in nil) (free t) (pop-out t))
  "Args: &KEY (TEXT NIL) (HIDE-LOGO NIL) (WIRE-FRAME NIL) (SHOW-TIME nil) (DELAY 0) (PAUSE NIL) (SPEED 1) (DISOLVE NIL) (REPEAT NIL) (FULL-SCREEN NIL SET) (SIZE '(440 220) SIZE?)  (TITLE NIL) (SHOW T) (LOCATION NIL) (TOP-MOST NIL) (DRAW-COLOR 'YELLOW) (BACK-COLOR 'YELLOW) (STATIC NIL) (X 50) (Y 0) (JUSTIFY \"left\") (MARGIN '(0 0 0 0))

Slide-Show shows the animated ViSta logo and, optionally, displays text messages. The logo is hidden when HIDE-LOGO is T, and is only a wire-frame drawing if WIRE-FRAME is T. TEXT specifies one or more messages, and may be 1) a list of strings; 2) a list of lists of strings; or 3) NIL. When TEXT is a list of strings, each string forms one line of one message. When TEXT is a list of lists of strings the elements of a list are displayed as the lines of a message, with the succeeding lists being used to form other messages. The series of messages is presented as a cycle of displays. The timing of the cycle is controlled by SHOW-TIME, which specifies the number of seconds a display is shown, and PAUSE, which specifies the number of seconds between messages. Each defaults to 0, meaning that the next message appears right after the user clicks on the window. The logo appears after DELAY seconds (the text appears immediately). This logo disappears immediately after the last message, unless DISOLVE is T, in which case it disolves slowly. SPEED controls how fast the logo moves. First line is horizontally left, center or right justified at X, depending on whether JUSTIFY is LEFT, CENTER or RIGHT. The first line is vertically located at Y. If neither SIZE nor FULL-SCREEN are used, SIZE is set to full screen if the global variable *screen-saver-full-screen* is T, to (440 220) otherwise. If SIZE is used, then the size will equal SIZE unless FULL-SCREEN is T, in which case the size will be full-screen. The twiddle is dynamic unless STATIC is T. CONTENT-PROPORTION specifies the proportion of the distance from the center of the screen to the edge that is used to contain the text and image (when static)."
  
  (when (numberp (first text))
        (let ((text-pointers text))
          (setf text nil)
          (mapcar #'(lambda (pointer)
                      (setf text (append text (list (get-message pointer))))
                      )
                  text-pointers)))
  (when (listp (first text)) (pad-text-lol text))
  (unless (listp (first text)) (setf text (list text)))

  (unless set (setf full-screen 
                    (when (and (boundp '*vista*) *vista*)
                          (send *vista* :screen-saver-full-screen))))
  (let* ((object (send logo-proto2 :new 4 
                       :draw-color draw-color :back-color back-color
                       :location location :size size :full-screen full-screen
                       ;dont change values below here
                       :window nil :show nil :go-away nil :glideing nil 
                       :container in :free free :pop-out pop-out :type 0 :about nil 
                       :message-number nil :local-menus t  :copyright-at-top t
                       ))
         (nlns (send object :num-lines))
         (n-msgs (length text))
         (indices (iseq nlns))
         (text-location 'center)
         (show-text t)
         (no-repeat (not repeat))
         (bumpy t)
         (dim 4)
         (speed-factor 1))
    (send object :black-on-white nil)
    (send object :x x)
    (send object :y y)
    (send object :p 0)
    (send object :wire-frame wire-frame)
    (send object :hide-logo hide-logo)
    (send object :pause pause)
    (send object :justify
          (cond
            ((equal justify "left") 0)
            ((equal justify "center") 1)
            ((equal justify "right") 2)))
    (setf show-time
          (cond 
            (used-show-time? 
             (if (< show-time 0) (error "show-time cannot be negative") show-time))
            ((< n-msgs 2) 3600)
            (t 20)))
    (send object :show-time show-time)
    (send object :menu nil)
    (send object :set-show-text t)
    (send object :animate nil)
    (send object :title (if title title " "))
    (send object :top-most top-most)
    (send object :msg-number 0)
    (send object :niter 0)
    (send object :no-repeat no-repeat)
    (send object :set-interrupts t)
    (defmeth object :do-click (&rest args) 
      (send self :shut-down))
    (defmeth object :do-key (&rest args) (send self :close)) 
    (defmeth object :do-alarm (&rest args) (send self :close))  
    (defmeth object :close () 
      (send self :idle-on nil) 
      (setf *logo* nil)
      (call-next-method)) 
    (setf *logo* object)
    (when (and (not *frames-per-second*) (or (not static) *show-flying-logo*))
	;(one-button-dialog "logoobj3 - calculating frames-per-second")
          (cond
            ((or (not *frames-per-second*)(< *frames-per-second* 1) )
             (setf *frames-per-second* (send object :get-frames-per-second))) 
            ((< 0 *run-number* 5)
             (setf *frames-per-second*
                   (round (/ (+ (* *run-number* *frames-per-second*)
                                (send object :get-frames-per-second)) 
                             (1+ *run-number*))))
             ))
          (send logo-proto :frames-per-second *frames-per-second*))
    (send object :frames-per-second *frames-per-second*)
    (when *verbose* (format t "~%; frames-per-second ~d" *frames-per-second*))
    (send object :speed (* speed (send object :get-frames-per-second)))
    (when *verbose* (format t " speed ~d~%" speed))
    (send object :open-window 
          (cond
            (set *real-screen-size*)
            (size? size)
            ((and (boundp '*vista*) *vista*
                  (send *vista* :screen-saver-full-screen)) *real-screen-size*)
            (t size)))
    (send object :dynamarg-content-proportion content-proportion)
    (send object :dynamarg-speed-factor speed-factor)
    (send object :dynamarg-margin margin)
    (send object :dynamarg-static static)
    (send object :dynamarg-iter 1)
    (cond
      ((not static)
       (send object :dynamarg? t)
       (send object :initialize-dynamarg))
      (t
       (apply #'send object :margin margin)))

    (send object :linestart-coordinate 3 
          (iseq (send object :num-lines))
          (standardize (uniform-rand (send object :num-lines))))
    (send object :std-logo)
    (send object :scale-type 'nil)

#|
 | NEXT STATEMENT CAUSES WINDOW TO APPEAR
 |#

    (cond 
      ((not show) (apply #'send object :location (+ '(100 100) (screen-size))))
      (location (apply #'send object :location location))
      (t (apply #'send object :frame-location
                (if full-screen '(-4 -4) 
                    (floor (* 1/2 (- (screen-size) size)))))))

    (send object :size-loc (combine size location))
    
    (if (= (length text) 0) (setf text (list (list " " " "))))
    (send object :msg-list text)
    (send object :msg-number 0)
    (send object :buffer (select text 0))

    (send object :x-lov 
          (list (send object :linestart-coordinate 0 indices)
                (send object :linestart-coordinate 1 indices)
                (send object :linestart-coordinate 2 indices)
                (send object :linestart-coordinate 3 indices)))

    (send object :speed (* .2 (/ (send object :speed))))
 
    (when (> delay 0)
          (send object :hide-logo t)
          (send object :idle-on nil)
          (send object :redraw)
          (pause (* 60 delay))
          (send object :hide-logo nil))
    
    (send object :timer-on (send object :show-time))
    (when static (send object :idle-on nil)(send object :redraw))
    object))

(defun slide-show (&rest args) 
"Alias for Twiddle."
  (apply #'twiddle args))


(defun text-list-to-text (text-list) (string-list-to-text text-list))

(defun string-list-to-text (string-list)
  (let ((text))
    (mapcar #'(lambda (string)
                (setf text (if text
                               (strcat text (string #\newline) string) string)))
            string-list)
    text))

(defun get-text-messages (num-msgs)
"Args: NUM-MSGS
Converts the structure of logo-proto text messages into the structure used by logo-proto2. The new structure allows for multiple text messages presented in cycles, which was awkward in logo-proto. Modifies message structure so that all text messages have the same number of lines (a requirement for logo-proto2) by padding with blank lines at the end."
  (get-text-messages-a 
   num-msgs 
   (max (mapcar #'length (get-text-messages-a 
                          num-msgs)))))

(defun get-text-messages-a (num-msgs &optional pad-num msg-num)
"Args: NUM-MSGS &OPTIONAL PAD-NUM MSG-NUM
Modify message structure so that all text messages have the same number of lines (a requirement for logo-proto2) by padding with blank lines at the end."
  (let* ((text-list)(temp-list))
    (mapcar #'(lambda (msg-num)
                (setf temp-list (send logo-proto :get-text msg-num))
                (if pad-num 
                    (setf temp-list (pad-text-list temp-list pad-num)))
                (setf text-list 
                      (append text-list 
                              (list temp-list))))
            (iseq 1 num-msgs))
    text-list))


(defun pad-text-list (temp-list pad-num)
  (when (< (length temp-list) pad-num)
        (dotimes (i (- pad-num (length temp-list)))
                 (setf temp-list (append temp-list (list " ")))))
  temp-list)

(defun pad-text-lol (text-lol)
  (let ((maxl (max (mapcar #'length text-lol))))
    (mapcar #'(lambda (text-list)
                (pad-text-list text-list maxl))
            text-lol)))




(defproto logo-proto2 '(msg-list p x-lov pause show-time time-limit animate speed msg-number no-repeat justify hide-logo wire-frame niter dynamarg-content-proportion dynamarg? dynamarg-speed-factor dynamarg-margin dynamarg-static dynamarg-iter size-loc) () logo-proto)

(defmeth logo-proto2 :msg-list (&optional (lol-of-strings nil set))
  (if set (setf (slot-value 'msg-list) lol-of-strings))
  (slot-value 'msg-list))


(defmeth logo-proto2 :size-loc (&optional (lol-of-strings nil set))
  (if set (setf (slot-value 'size-loc) lol-of-strings))
  (slot-value 'size-loc))

(defmeth logo-proto2 :p (&optional (number nil set))
  (if set (setf (slot-value 'p) number))
  (slot-value 'p))

(defmeth logo-proto2 :x-lov (&optional (number nil set))
  (if set (setf (slot-value 'x-lov) number))
  (slot-value 'x-lov))

(defmeth logo-proto2 :msg-number (&optional (number nil set))
  (if set (setf (slot-value 'msg-number) number))
  (slot-value 'msg-number))

(defmeth logo-proto2 :pause (&optional (number nil set))
  (if set (setf (slot-value 'pause) number))
  (slot-value 'pause))

(defmeth logo-proto2 :show-time  (&optional (number nil set))
  (if set (setf (slot-value 'show-time ) number))
  (slot-value 'show-time ))

(defmeth logo-proto2 :time-limit  (&optional (number nil set))
  (if set (setf (slot-value 'time-limit ) number))
  (slot-value 'time-limit ))

(defmeth logo-proto2 :animate (&optional (logical nil set))
  (if set (setf (slot-value 'animate) logical))
  (slot-value 'animate))

(defmeth logo-proto2 :speed (&optional (number nil set))
  (if set (setf (slot-value 'speed) number))
  (slot-value 'speed))

(defmeth logo-proto2 :no-repeat (&optional (logical nil set))
  (if set (setf (slot-value 'no-repeat) logical))
  (slot-value 'no-repeat))

(defmeth logo-proto2 :hide-logo (&optional (logical nil set))
  (if set (setf (slot-value 'hide-logo) logical))
  (slot-value 'hide-logo))

(defmeth logo-proto2 :wire-frame (&optional (logical nil set))
  (if set (setf (slot-value 'wire-frame) logical))
  (slot-value 'wire-frame))

(defmeth logo-proto2 :justify (&optional (number nil set))
  (if set (setf (slot-value 'justify) number))
  (slot-value 'justify))

(defmeth logo-proto2 :niter (&optional (number nil set))
  (if set (setf (slot-value 'niter) number))
  (slot-value 'niter))

(defmeth logo-proto2 :dynamarg-content-proportion (&optional (arg nil set))
  (if set (setf (slot-value 'dynamarg-content-proportion) arg))
  (slot-value 'dynamarg-content-proportion))

(defmeth logo-proto2 :dynamarg-speed-factor (&optional (arg nil set))
  (if set (setf (slot-value 'dynamarg-speed-factor) arg))
  (slot-value 'dynamarg-speed-factor))

(defmeth logo-proto2 :dynamarg-margin (&optional (arg nil set))
  (if set (setf (slot-value 'dynamarg-margin) arg))
  (slot-value 'dynamarg-margin))

(defmeth logo-proto2 :dynamarg-static (&optional (arg nil set))
  (if set (setf (slot-value 'dynamarg-static) arg))
  (slot-value 'dynamarg-static))

(defmeth logo-proto2 :dynamarg-iter (&optional (arg nil set))
  (if set (setf (slot-value 'dynamarg-iter) arg))
 (slot-value 'dynamarg-iter))

(defmeth logo-proto2 :dynamarg? (&optional (arg nil set))
  (if set (setf (slot-value 'dynamarg?) arg))
 (slot-value 'dynamarg?))

(defmeth logo-proto2 :do-the-show () (send self :next-slide))
           
(defmeth logo-proto2 :next-slide (); (msg-list msg-i show-time pause no-repeat)
"This method presents the complete set of n (may be 1) messages repeatedly. Each message is presented for SHOW-TIME seconds with an interval of PAUSE seconds between messages. The presentation ends when a click/key/time action makes it end, or, if no-repeat is T, at the end of the set of messages."
  (let* ((msg-list (send self :msg-list))
         (msg-i (send self :msg-number))
         (show-time (send self :show-time))
         (pause (send self :pause))
         (no-repeat (send self :no-repeat))
         (n (length msg-list)))
    (setf msg-i (1+ msg-i))
    (when (> n msg-i)
          (when (send self :buffer) 
                (send self :erase-line-list 
                      (send self :buffer)     
                      (send self :x) 
                      (send self :y)))
          (send self :write-line-list 
                (select msg-list msg-i) 
                (send self :x) 
                (send self :y))
          (send self :timer-on show-time))
    (when (= n msg-i) 
          (cond (no-repeat 
                 (send self :shut-down))
            (t (setf msg-i 0)
               (when pause (pause pause)))))
    (send self :msg-number msg-i)))

(defmeth logo-proto2 :dynamarg ()
    (let* ((content-proportion (send self :dynamarg-content-proportion))
           (speed-factor (send self :dynamarg-speed-factor))
           (margin (send self :dynamarg-margin))
           (static (send self :dynamarg-static))
           (size (send self :size))
           (f content-proportion) 
           (n (floor (* (/ 140 f) speed-factor)))
           (wid (floor (first size)))
           (hid (floor (second size)))
           (wid0 0) (widi) (widn (floor (- wid (/ wid (first size)))))
           (hid0 0) (hidi) (hidn (floor (/ widn 2)))
           (hor-marg (floor (/ (- wid wid0) 2)))
           (ver-marg (max 0 (floor (/ (- hid hid0) 2))))
           (user-marg margin)
           (i nil))

      (dotimes (j 20)
               (setf i (send self :dynamarg-iter))
      (cond 
        (static
         (apply #'send self :margin 
                (if margin margin (combine (repeat (ceiling (/ size 10)) 2)))))
        ((< i (* f n))
         (when (> i (* f n .25)) ;35
               (send self :animate (not static)))
         (send self :margin 
               (max (select user-marg 0) (floor (* (/ (- n i) n 2) widn)))
               (max (select user-marg 1) (floor (* (/ (- n i) n 2) hidn)))
               (max (select user-marg 2) (floor (* (/ (- n i) n 2) widn)))
               (max (select user-marg 3) (floor (* (/ (- n i) n 2) hidn))))
         (send self :dynamarg-iter (1+ i)))
        (t
         (send self :dynamarg? nil))))
      ))

(defmeth logo-proto2 :initialize-dynamarg ()
    (let* ((wid (first (send self :size)))
           (widn (- wid 1))
           (hidn (floor (/ widn 2)))
           (n (floor (* (/ 140 (send self :dynamarg-content-proportion)) 
                        (send self :dynamarg-speed-factor))))
           (user-marg (send self :margin)))
      (send self :margin 
               (max (select user-marg 0) (floor (* (/ n 2) widn)))
               (max (select user-marg 1) (floor (* (/ n 2) hidn)))
               (max (select user-marg 2) (floor (* (/ n 2) widn)))
               (max (select user-marg 3) (floor (* (/ n 2) hidn))))))


(defmeth logo-proto2 :do-idle ()
  (cond 
    ((send self :dynamarg?)
     (send self :dynamarg))
    (t
     (send self :redraw))))

(defmeth logo-proto2 :disolve 
  (&key (rotations-per-second 6)(spin-seconds 0) (close t)
        (fade-seconds 2)(direction -1)(disolve-type 0))
  (case disolve-type
    (0 (send self :idle-on nil) )
    (1 (defmeth self :do-idle ())
       (send self :transf nil)
       (send self :ready t)
       (send self :idle-on t)))
    (send self :dynamic t)
    (send self :glide 
        (/ 1 (* 2 rotations-per-second))
        spin-seconds
        fade-seconds
        (1- (mod *run-number* 3)) ; -1
        nil :close close)
  t)

(defmeth logo-proto :fade 
  (&key (rotations-per-second 3) (spin-seconds 0) (fade-seconds 2))            
  (defmeth self :do-idle ())
  (send self :transf nil)
  (send self :ready t)
  (send self :idle-on t)
  (send self :dynamic t)
  (send self :glide 2 1 2 1 ; (1- (mod *run-number* 3)) ; 2 1 2 1
        nil :close t)
  t)

(defmeth logo-proto2 :closing-method ())

(defmeth logo-proto2 :shut-down ()
  (send self :closing-method)
  (send self :set-interrupts nil)
  (send self :idle-on nil)
  (send self :timer-on nil)
  (send self :remove)
  ;(top-level nil)
  )

(defmeth logo-proto2 :do-timed-idle (timed-out?)
"This method done repeatedly during timed idling. TIMED-OUT? indicates whether or not the preset time period has elapsed (the timer has timed-out)"
  (if timed-out? 
      (send self :do-the-show )
      (send self :do-one-interpolation))
  (print (list "do-timed-idle reporting, sir. timed-out is" timed-out?)))

       
(defmeth logo-proto2 :do-click (x y m1 m2) 
  (send self :shut-down))
       
(defmeth logo-proto2 :do-key (c m1 m2) 
  (send self :shut-down))
       
(defmeth logo-proto2 :do-time () 
  (send self :do-the-show))

(defmeth logo-proto2 :set-interrupts (on) (send self :make-interrupt-methods on))

(defmeth logo-proto2 :make-interrupt-methods (on)
    (cond
      (on
       (defmeth self :do-timed-idle (timed-out?)
         "This method done repeatedly during timed idling. TIMED-OUT? indicates whether or not the preset time period has elapsed (the timer has timed-out)"
         (if timed-out? 
             (send self :do-the-show )
             (send self :do-one-interpolation))
         )
       (defmeth self :do-click (x y m1 m2) (send self :shut-down))
       (defmeth self :do-key (c m1 m2) (send self :shut-down))
       (defmeth self :do-time () (send self :do-the-show))
       on)
      (t
       (defmeth self :do-timed-idle (timed-out?))
       (defmeth self :do-click (x y m1 m2))
       (defmeth self :do-key (c m1 m2))
       (defmeth self :do-time ())
       on
       )))
(setf *logo-time* 0)

(defmeth logo-proto2 :do-one-interpolation ()
  ;(send self :std-logo)
  (let* ((x-lov (send self :x-lov))
         (p (send self :p))
         (n (min 100 (send self :niter)))
         (speed (send self :speed))
         (increment (if (send self :animate) 
                        ;(* speed (/ n 100) 1)
                        (*  (/ n 100) .01)
                        .00))
         (indices (iseq (send self :nlines)))
         (alpha (* (/ pi 2) p))
         (s (sin alpha))
         (c (cos alpha))
         (a 3)
         (b 0)
         (x (+ (* c (select x-lov 0)) (* s (select x-lov 1))));0 2
         (y (+ (* c (select x-lov 1)) (* s (select x-lov 2))));1 3
;1                3 vistas         1               3
;0 see 4 vistas   0 see 2 upright  2 see 1 upright 2 see 1 upright
        ;(x (+ (* c x) (* s (select x-lov a))))
         (y (+ (* c y) (* s (select x-lov b)))) 
         )
   ; (send self :rotate-2 0 1 (/ pi 360))
   ;(send self :rotate-2 0 2 (/ pi 360))
    (when (send self :nlines)
          (setf p 
                (cond 
                  ((> p 4) ;p=1 is 90 degree rotation; 2 is 180, 4 is 360
                   (let* ((new-time (get-internal-real-time))
                          (elapsed-time (- new-time *logo-time*)))
                     (setf speed (* speed (/ elapsed-time 60)))
                    ; (send self :speed speed)
                     (setf *logo-time* new-time)
                     (send self :x-lov 
                         (list (select (send self :x-lov) 0)
                               (select (send self :x-lov) 1)
                               (select (send self :x-lov) 2)
                               (coerce 
                                (standardize 
                                 (- (uniform-rand (send self :num-lines)) .5))
                                'vector)
                               
                               )))
                   (- p 4))
                  (t
                   (+ p increment))))
          (send self :p p)
          (send self :niter (1+ (send self :niter)))
          (send self :linestart-coordinate 0 indices x)
          (send self :linestart-coordinate 1 indices y))
    ))

(defmeth logo-proto2 :redraw ()
  (when (and (send self :num-lines)(send self :x-lov))
        (send self :start-buffering)
        (unless (send self :hide-logo)
                (send self :do-one-interpolation)
                (send self :fill-logo))
        (send self :write-line-list (send self :buffer))
        (send self :buffer-to-screen)
        ))
  
(defmeth logo-proto2 :std-logo ()
  (let ((nlns (send self :num-lines))
        (lnstrts) (mean))
    (when (> nlns 2)
    (mapcar #'(lambda (dim)
                (setf lnstrts (send self :linestart-coordinate dim (iseq nlns)))
                (if (< (length (unique-values lnstrts)) 3)
                    (progn
                     (format t 
                       "; cant standardize logo dimension ~a. using range instead" dim)
                     (setf range (range lnstrts))
                     (when (= range 0) (format t "; cant use range. it is 0"))
                     (setf lnstrts (if (= range 0) (repeat 0 nlns) (/ lnstrts range))))
                    (setf lnstrts (standardize lnstrts)))
                (send self :linestart-coordinate dim (iseq nlns) lnstrts))
            (iseq 4)))))

(defmeth logo-proto2 :roto-twiddle (p)
;rotates 360 degrees from dimensions 0 and 1 through 2 and 3 and back to 0 and 1
;using 4*p interpolates to do it
  (let* ((x-lov (send self :slot-value 'x-lov))
         (indices (iseq (send self :nlines)))
         (alpha (* 4 (/ pi 2) p))
         (s (sin alpha))
         (c (cos alpha))
         (x (+ (* c (select x-lov 0)) (* s (select x-lov 2))))
         (y (+ (* c (select x-lov 1)) (* s (select x-lov 3))))
         )
    (send self :start-buffering)
    (send self :linestart-coordinate 0 indices x)
    (send self :linestart-coordinate 1 indices y)
    (send self :redraw-content)
    (send self :write-line-list (send self :buffer))
    (send self :buffer-to-screen)
     ))


(defmeth logo-proto2 :magic-show (size show margin animate-margin 
                                      &optional full-screen )
  (send self :screen-saver t)
  (send self :open-window (if full-screen nil size) show)
  (mapcar #'(lambda (dim)(send self :scale dim 1) (* .5 (send self :scale dim))) (iseq 4))
  (send self :write (send self :buffer)))

(defmeth logo-proto2 :open-window (size &optional show)
"#-ViSta #+Containers 
ARG: SIZE 
Opens window to size SIZE. Opens full screen if SIZE is NIL. Does not show window. It opens the window off screen where it cant be seen. It can be further manipulated before sliding it on screen, hiding the messy details often seen with show-window."
  (send self :showing nil)
  (send self :margin 0 0 0 0)
  (send self :location 3000 0)
  (if (not size) (apply #'send self :size (+ (screen-size) '(8 28)))
      (apply #'send self :size size))
  (send self :front-window)
  (send self :top-most t)
  (when show 
        (apply #'send self :frame-location
               (if (not size) '(-4 -4) 
                   (floor (* 1/2 (- (screen-size) size))))))
  (send self :size))

(defmeth logo-proto2 :magic-margin (margin w animate-margin)
  (cond
    ((listp margin)
     (if margin (apply #'send w :margin margin)
         (if animate-margin
             (send w :set-margin)
             (send w :margin 0 0 0 0))))
    (margin
     (send w :set-margin)
     (setf margin (send w :margin)))
    ))

;     (stop-all-plots)

(defmeth logo-proto2 :write (line-list &optional x y)
"Args: LINE-LIST &OPTIONAL X Y
Write LINE-LIST, a list of strings, to the window, starting at location x,y. If x and y are not both specified, writes inside a 440x220 rectangle which is centered in the window."
  (send self :write-line-list line-list x y))

(defmeth logo-proto2 :set-show-text (flag) 
  (send self :copyright-flag (not flag))
  (send self :simple-write-flag (not flag))
  (send self :dynamic flag)
  (send self :glideing (not flag)))

(defmeth logo-proto2 :erase-line-list (line-list &optional x y)
  (let ((dc-in (send self :draw-color))
        (bc-in (send self :back-color)))
    (send self :draw-color (send self :back-color-default))
    (send self :back-color (send self :draw-color-default))
    (send self :redraw-line-list line-list x y)
    (send self :draw-color dc-in)
    (send self :back-color bc-in)))

(defmeth logo-proto2 :write-line-list (line-list &optional x y)
  (let ((dc-in (send self :draw-color))
        (bc-in (send self :back-color)))
    (send self :draw-color (send self :draw-color-default))
    (send self :back-color (send self :back-color-default))
    (send self :redraw-line-list line-list x y)
    (send self :draw-color dc-in)
    (send self :back-color bc-in)))

(defmeth logo-proto2 :redraw-line-list (line-list &optional x y)
  (let* ((x (if x x (send self :x)))
         (y (if y y (send self :y)))
         (j (send self :justify))
         (text-origin (if (and x y)
                          (list x y)
                          (floor (/ (- (send self :size) '(448 232)) 2))))
         (text-size (+ 1 (send self :text-ascent) (send self :text-descent)))
         (next-line (list 0 text-size))
         (textline1 (second text-origin)) ; (max 8 (+ 8 (second text-origin))) ; 8 8
         (left (first text-origin)) ;(+ 25 (first text-origin))
         (nlines (length line-list))
         (dc (send self :draw-color))
         (bc (send self :back-color)))
    (setf textline1 (max textline1 0))
    (if (or (not x) (not left) (< left 0) (< x 0))
        (setf left 25)
        (setf left (max left x)))

    (mapcar #'(lambda (text i)
                (send self :write-text text left (+ textline1 (* i text-size)) j 1 i))
            line-list (iseq nlines))
    t))



(defmeth logo-proto2 :write-text 
          (text &optional locx locy (p 1) (q 1) (bufnum 0))
  (let* ((text-size (+ 1 (send self :text-ascent) (send self :text-descent)))
         (loc (if locx (list locx locy)
                  (+ (send self :real-to-canvas 15 -1)
                     (* 3 (list 0 text-size)))))
         (buffer (send self :buffer)))
    (when  text
          (send self :draw-text text (first loc) (second loc) p q)
          (setf (select buffer bufnum) text)
          (send self :buffer buffer))
    loc))


